COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "FREQ"
C00005 00003	string lin
C00008 ENDMK
C⊗;
begin "FREQ"
Comment
Scans a text file to determine number of occurances of each kind of
character, with upper and lower case characters merged and ignoring
<carriage return>, then prints them in order of decreasing frequency.
;
require "[]<>" delimiters;
define !=[Comment];
define TAB=[(""&'11)],LF=[(""&'12)],VT=[(""&'13)],FF=[(""&'14)],CR=[(""&'15)],
ALT=[(""&'175)],DEL=[(""&'177)],↓=[(CR&LF)],
thru=[step 1 until],
ln=[length],
proc=[simple procedure],
say=[outstr],
exit=[quick_code calli '12 end],
inlines=[input(inch,inlf)],
informs=[input(inch,inff)];

INTEGER INCH,OUCH,BRK,EOF,INLF,INFF,inprt,inwht; ! INPUT/OUTPUT GLOBALS;

proc PREP0;  begin 				! initialize things;
    setbreak(inlf←getbreak,LF,CR,"INS");
    setbreak(inff←getbreak,FF,NULL,"INS");
    end;
require PREP0 initialization;

string proc ask(string s);  begin outstr(s);  return(inchwl)  end;

proc OOPS(string mess); begin say(↓&mess&↓); call(0,"RESET"); exit; end;

string proc look(string file);  begin
! does an open and lookup on a text file and delivers the first line,
ignoring the TV/E directory,if any;
    string lin; boolean fl;
    open(inch←getchan,"DSK",1,19,0,400,brk,eof);
    lookup(inch,file,fl);
    if fl then begin release(inch); return(del) end;
    lin←inlines;
    if equ(lin[1 to 9],"COMMENT ⊗") then begin "flush directory"
	do informs until brk=ff;
	return(inlines);
	end;
    return(lin)
    end "LOOK";
string proc lookout(string file);	begin	string ss;
	if ¬equ(ss←look(file),del) then return(ss) else oops(file&" not found"&↓);
	return(ss)
	end;
string lin;
integer i,j,chartyp,charno,pages;
boolean sorted;
integer array charcnt[0:127],ord[1:126];

charno←0;
lin←lookout(ask("File="));
while ¬eof do begin "count"
    integer ch;

    charcnt['12]←charcnt['12]+1;	! count line feeds;
    charno←charno+ln(lin) + 1;		! character count;
    while (ch←lop(lin)) do begin
	if "A"≤ch≤"Z" then ch←ch+'40;	! changes upper case to lower;
	charcnt[ch]←charcnt[ch]+1;
	end;
    lin←inlines;
    end "count";
print(charno," characters, ",charcnt['12]," lines, ",charcnt['40]," spaces, ",
  charcnt['11]," TABs, ",charcnt['14]," pages"&↓);
chartyp←0;				! set up sort pointers;
for i←'41 thru '176 do if charcnt[i] then ord[chartyp←chartyp+1]←i;
print(chartyp," character types"&↓);
i←chartyp;
do begin "bubble"
    i←i-1;				! step range down 1 each pass;
    sorted←true;
    for j←1 thru i do if charcnt[ord[j]]<charcnt[ord[j+1]] then begin "swap";
	sorted←false;
	ord[j]↔ord[j+1];
	end;
    end "bubble" until sorted;
for i←1 thru 10 do begin "frequencies"
    string proc showit(integer loc); begin
	integer ch;
	return(if loc≤chartyp then (ch←ord[loc])&" "&cvs(charcnt[ch]) else null);
	end;
    print(showit(i),tab,showit(i+10),tab,showit(i+20),tab,showit(i+30),tab,
      showit(i+40),tab,showit(i+50),↓);
    end "frequencies"
end "FREQ"